home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / parser / parser-driver.scm < prev    next >
Encoding:
Text File  |  1994-09-27  |  1.7 KB  |  54 lines  |  [TEXT/CCL2]
  1.  
  2. ;;; This is the top level entry to the parse.  The input is a list of file
  3. ;;; names to be parsed and the output is a list of modules.  Interface files
  4. ;;; generate modules similar to ordinary files.  
  5.  
  6. (define (parse-files filenames)
  7.   (let ((all-mods '()))
  8.     (dolist (file filenames)
  9.       (let* ((ext (filename-type file))
  10.          (mods (cond ((string=? ext ".hs")
  11.               (parse-single-file file))
  12.              ((string=? ext ".lhs")
  13.               (parse-single-file/literate file))
  14.              ((string=? ext ".hi")
  15.               (parse-single-file/interface file))
  16.              ((string=? ext ".lhi")
  17.               (parse-single-file/literate-interface file)))))
  18.        (setf all-mods (append all-mods mods))))
  19.     all-mods))
  20.  
  21. (define (parse-single-file filename)
  22.   (parse-single-file-1 filename '#f '#f))
  23.  
  24. (define (parse-single-file/literate filename)
  25.   (parse-single-file-1 filename '#t '#f))
  26.  
  27. (define (parse-single-file/interface filename)
  28.   (parse-single-file-1 filename '#f '#t))
  29.  
  30. (define (parse-single-file/literate-interface filename)
  31.   (parse-single-file-1 filename '#t '#t))
  32.  
  33. (define (parse-single-file-1 filename literate? interface?)
  34.   (when (memq 'reading *printers*)
  35.       (format '#t "Reading Haskell source file ~s.~%" filename))
  36.   (when (not (file-exists? filename))
  37.     (signal-file-not-found filename))
  38.   (dynamic-let ((*current-file* filename))
  39.     (let ((mods '()))
  40.       (call-with-input-file filename
  41.         (lambda (port)
  42.       (let* ((tokens (lex-port port literate?))
  43.          (module-asts (if interface?
  44.                   (parse-tokens/interface tokens)
  45.                   (parse-tokens tokens))))
  46.         (setf mods module-asts))))
  47.       (when (memq 'parse *printers*)
  48.     (dolist (m mods)
  49.       (format '#t "~%")
  50.       (print-full-module m)))
  51.       mods)))
  52.  
  53.  
  54.